perm filename PLOT5.FAI[NEW,LCS]1 blob
sn#513484 filedate 1980-06-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE PLOT
C00010 00003 SETUP: SETOM LINE
C00012 00004 XINI: OUTSTR [ASCIZ /PAGE HEIGHT? (<CR>=11") /]
C00015 00005 PLOT1: PUSHJ P,GETAC GET BACK ALL ACS
C00018 00006 XCHA: SETZ 14, ↓↓MOVE UP AND RIGHT
C00022 00007 MVLFT: MOVMS 0 MOVE LEFT THEN RIGHT
C00025 00008 OOBAR: SETZM OOBFLG GET HERE IF ALL READY OOB
C00029 00009 FINDL: HRRZ A,JOBREL CK IF BIG ENUF
C00034 00010 INBITS: PUSHJ P,NAMGET INPUT OLD BIT FILE
C00038 00011 CORUP
C00040 00012 ******** TYPE '4' FOR 4X4 DOTS, TYPE '9' FOR 9X9 DOTS.***********
C00042 00013 GETNAM: MOVEI A, FILE SCAN
C00044 ENDMK
C⊗;
TITLE PLOT
INTERNAL PLOT,VARIAN
EXTERNAL EXTOUT,FINEXT,EXIT,PUTEXT,OUTF,TTOP,DL,TYPWRD
;**** TO WRITE ON UDP1: USE DDT TO PUT IN 'JFCL' AT LABEL "UDP".
;; COMMON /DL/RSIZ,SAVER,NAME,EXT
;;TITLE VM ;PRINTS MUSIC FORMAT FILE ON VARIAN PRINTER.
;↓↓AC DEF
A←1
B←2
C←3
D←4
E←5
L←6
U←7
X←11
Y←12
XD←13
T←15
TT←16
P←17
;;LPDL←←69
NBUFS←←4
DSK←←1
XGP←←2 ;DEVICE NAME OF VARIAN STATOS
LMAR←←=0
RMAR←←=1699
WIDTH←←=1700
LBUFL←←=48 ;LINE LENGTH IN WORDS
LSTBIT←←1⊗34
OVERLAP←←=50
EXTERN JOBREL,JOBFF,JOBTPC,JOBAPR,JOBCNI
MAILBF: BLOCK 40
SIGN: 0
LINE: 0
PNTR: 0
SVX: 0
SVY: 0
SVPEN: 0
LX: 0
VARIAN: 0 ;DO SET UP FOR VARIAN OUTPUT.
MOVE DL ;GET THE SIZE FACTOR
CAMG [1.06] ;1.06 IS MAX. SIZE FOR THIS PROG. (NO MORE CORE!)
JRST .+3
OUTSTR [ASCIZ/**** TOO BIG. MAX SIZE =1.06 ****/]
CALLI 12 ;EXIT IF TOO BIG
MOVEM 16,ACZ ;SAVE AC16 FOR RETURN
MOVNM 4,LX ;L=1
SETZM OUTF+2 ;VECTOR COUNTER (TEMPORARY, I HOPE)
MOVEI 4,=50000
MOVEM 4,TTOP+1 ;INITIALIZE JBOT AND JTOP
MOVNM 4,TTOP ;JBOT=50000, JTOP=-50000
MOVNM 4,RTMAX# ;RTMX=-50000
MOVEM 4,SVX ;INIT OLD X AND Y
MOVEM 5,SVY
MOVE 0,[1700.0] ;STANDARD PAGE WIDTH=8.5"
FMPR 0,DL ;TIMES GIVEN SIZE FACTOR
KIFIX ;FIX IT
MOVEM PWIDTH ;THIS WILL ALSO BE IN THE HEADER (SEE LATER)
MOVE [900.0]
FMPR DL ;GET THE OFFSET VALUE
KIFIX
MOVEM SHIFT# ;USED IN MAIN LOOP - AFTER PLOT1
XNTF4: MOVE 0,OUTF ;***** THIS CONVERTS ASCIZ WORD TO SIXBIT***
MOVEM 0,FNX# ; *
MOVE 1,[POINT 7,FNX] ; *
XNTF3: MOVE 2,[POINT 6,FILNAM] ; *
SETZM FILNAM ; *
MOVEI 3,5 ; *
XNTF1: ILDB 0,1 ; *
CAIN 0," " ; *
JRST XNTF2 ; *
SUBI 0,40 ; *
IDPB 0,2 ; *
SOJG 3,XNTF1 ;*******************************************
XNTF2: SETOM OUTF ;JJ=-1 IS THIS NEEDED?
PUSHJ P,SETUP ;GO SET UP VM PROG.
PLZ: MOVE 16,ACZ ;GET BACK AC16
JRA 16,(16) ;VARIAN SETUP ALL DONE
PLOT: 0 ;SUBROUTINE PLOT(I,J,K)
PUSHJ P,SAVACZ ;SAVE ALL ACS
PL4: MOVE 5,@2(16) ;4 IF(K.EQ.99)GO TO 1
;;; CAIN 5,=99
CAIE 5,=99
JRST PLX
SKIPE SAVBIT ;WRITE FILE?
JRST OUTFIL ;YES PUSHJ P,OUTFIL ;GO OUTPUT BIT MAP
JRST PCUT ;GO DO OUTPUT TO VRN.
PLX: MOVEM 5,SVPEN
MOVE 4,@(16) ;IF(X2.EQ.SVX.AND.Y2.EQ.SVY)RETURN
MOVE 5,@1(16) ;AVOID DUPLICATE COORDS.
CAMN 4,SVX
CAME 5,SVY
JRST DIFRNT
SKIPL 15,@2(16) ;SKIP IF -3 IN PEN CODE
JRA 16,3(16) ;RETURN
DIFRNT: MOVEM 4,SVX
MOVEM 5,SVY ;SAVE X AND Y FOR NEXT TIME
PUSHJ P,PLOT1 ;GO TO BIT MAP ROUTINE
PUSHJ P,GETACZ ;GET BACK ALL ACS
AOS OUTF+2 ;UPDATE VECT. COUNTER
NZZ: MOVE 1,@1(16) ;****ALL THIS TO FIND TRUE VERTICAL SIZE OF IMAGE.
MOVEI 0,2 ;****
CAME 0,SVPEN ;**** IS PEN DOWN (=2)?
JRST NXX ;**** NO
CAMLE 1,TTOP ;**** GETS Y COORD.
MOVEM 1,TTOP ;****
CAMGE 1,TTOP+1 ;**** THIS AREA SAVES TOP AND BOT LIMITS
MOVEM 1,TTOP+1 ;****
MOVE 1,INVIS ;****
CAMLE 1,TTOP ;****
MOVEM 1,TTOP ;**** THIS TO AVOID INCLUDING 1ST AND LAST
CAMGE 1,TTOP+1 ;**** INVISIBILE POSITIONS.
MOVEM 1,TTOP+1 ;****
MOVE 1,@(16) ; GET X COORD.
CAMLE 1,RTMAX ; IS THIS FURTHER TO RIGHT?
MOVEM 1,RTMAX ;YES WRITE THIS AS LAST WD. OF FILE
JRST NWW ;****
NXX: MOVEM 1,INVIS# ;****
SKIPL SVPEN ;**** SKIP IF PEN=-3 (RESETS TO 0,0)
JRST NWW ;****
MOVN 1,@1(16) ;**** GET Y FOR PEN RESET
ADDM 1,TTOP ;**** SUBTRACT NEW POS. FROM BOTH TOP AND BOT
ADDM 1,TTOP+1 ;****
NWW: MOVE 7,LX
JRA 16,3(16) ;GO BACK FOR ANOTHER VECTOR
SETUP: SETOM LINE
GETLIN LINE ;FOR ERROR PRINTOUT
CALLI
HRRZS LINE ;CLEAR LINE BITS
HRRZI A,CORUP
HRRZM A,JOBAPR
SETOM SSS#
SETZM ROT1# ;1ST TIME FLAG
SETZM SAVBIT# ;FLAG TO SAVE BITS.
HRRZ A,JOBFF ;RESET CORE WITHOUT A RESET
CORE A,
JRST 4,.
MOVEI A,20000 ;REG MPV
APRENB A, ;REG ENABLE OLD WAY!
CAMN A,[ASCIZ/PLT /] ;OUTF IS NAME FROM MAIN PROG.
JRST FILIN-1 ;WILL GO DIRECTLY TO VRN
SETOM SAVBIT ;NAME GIVEN, SO WRITE A FILE WHEN DONE
SKIPA
OUTSTR [ASCIZ/ WILL GO DIRECTLY TO VARIAN
/]
FILIN: HRREI B,-60
HRREI A,-=760 ; YES, DEFAULT = 11" PAGE
YDEF: ADD A,B
MOVNM A,INIX#
ASKLEN: SETZM POOBX#
SETZM POOBY#
PUSHJ P,XINI ;GET X INFO
SETZM XX#
SETZM YY#
MOVEI C,3
HRRZM C,PENN#
PUSHJ P,SAVAC ;SAVE ALL ACS
POPJ P, ;GO BACK TO OLD PLOT
XINI: OUTSTR [ASCIZ /PAGE HEIGHT? (<CR>=11") /]
PUSHJ P,RNUM ;SKIP NEXT IF A NUMBER WAS TYPED.
JRST DEFAU ;USE DEFAULT VALUE 11"=850 X OFFSET
CAIG A,=11
JRST DEFAU ;NO PAGE .LT.11" FOR NOW
;; SUBI A,=11 ;TAKE AWAY BASIC 11" HEIGHT
IMULI A,=200 ;200 LINES/INCH
;; SUBI A,=850 ;LESS DEFAULT OFFSET
MOVNS A
SKIPA
;;DEFAU: MOVEI A,=850
DEFAU: MOVEI A,=2200
MOVEM A,XSHIFT# ;X OFFSET VALUE
MOVE A,PWIDTH
MOVEI B,-1(A)
IMULI A,LBUFL+1 ;A← BUFSIZ ← ROWS * COL
MOVE T,JOBFF ;GET START ADDR
MOVEM T,XGPPTR
SOS XGPPTR
MOVEI T,2(A)
MOVNI TT,(T)
ADD T,XGPPTR
HRLM TT,XGPPTR ;XGPPTR← -WDCNT,,ADDR-1
MOVE TT,T
HRRZ L,XGPPTR
MOVSI T,1(L)
HRRI T,2(L)
SETZM 1(L)
MOVE U,JOBREL
BLT T,(U) ;ZERO TO END OF CORE
HRRZI U,(TT)
MOVEM B,SVBBB#
MOVEI Y,2(L)
MOVEI XD,DBUF+1
SKIPL A,INIX ;WHERE DO WE START
JRST MAYBON
SUBI A,43
IDIV A,[-44]
HRLOI X,XD
SOJA A,SETB
MAYBON: ADDI A,43
IDIVI A,44
CAILE A,LBUFL
JRST OFFRT
MOVE X,A
SETZ A,
HRLI X,Y
JRST SETB
OFFRT: MOVE X,[XD,,LBUFL]
SUBI A,LBUFL
SETB: MOVE B,INIX
IDIVI B,44
MOVSI B,400000
MOVN C,C
ROT B,(C)
POPJ P,
POPJ1: AOS (P)
CPOPJ: POPJ P,
PLOT1: PUSHJ P,GETAC ;GET BACK ALL ACS
MOVE 15,SVPEN
JUMPG 15,NORSET ;NEXT FOR RESET OF COORDS TO 0,0 (SVPEN=-1)
MOVE 15,SVX
SKIPN ROT1# ;ROT1=FLAG FOR FIRST TIME
sub 15,INIX ;1ST TIME SHIFT. ADD INITIAL OFFSET
ADDM 15,XSHIFT ;GET NEW XSHIFT
SETOM ROT1
POPJ P,
NORSET: HRR C,IBUF+1
MOVN E,1(C) ;FIX FOR NO WDCNT
PLOTX: MOVSI E,(E)
HRR E,IBUF+1
MOVE 14,2(E)
;;PLOT1: MOVE 14,2(E)
LSHC 14,-10
ASH 15,-34
MOVEM 15,SVPEN# ;GET PEN CODE
MOVM A,15
LSHC 14,-16
ASH 15,-26
SKIPL SVPEN
ADD 15,SHIFT ;SHIFT UP OR DOWN
MOVEM 15,SVY# ;GET Y
SUB 15,YY
MOVEM 15,SVYSB# ;SAVE Y DIFF
IMULI 15,LBUFL+1
ADD 15,Y
MOVEM 15,SVYOD# ;SAVE NEW Y
CAIGE 15,(L) ;OFF TOP
JRST LOSE
CAIL 15,-LBUFL-1(U) ;OFF BOTTOM
JRST LOSE
LSHC 14,-16
ASH 15,-26
MOVEM 15,SVX# ;GET X
SUB 15,XX
MOVE 0,15 ;0 HAS X DIFF
HRRZ 16,X
IMULI 16,44 ;TIMES BITS INA WORD
JFFO B,.+1
ADD 16,C ;PLUS REMAINDER EQ OLD X
SUB 16,15
JUMPL 16,LOSEX
CAILE 16,=1727
JRST LOSEX
SKIPE OOBFLG# ;CK IF ALREADY OOB
JRST OOBAR
FIXUP: CAIE A,1 ;FIXUP WHAT?
HRRM A,PENN
HRR A,PENN ;SAME PEN IF 1
CAIN A,3
JRST PENUP ;PENUP IF 3
MOVE C,SVYSB ;Y DIFF
IORM B,@X ;MARK NOW X Y
;FIND DIRECTION
JUMPE NORMX ;VERT OR NO MOVE
JUMPL MVLFT ;LEFT
JUMPE C,NRT ;HORZ
JUMPL C,MVDWN ;DOWN
CAMLE C,0 ;JUMP IF Y DIFF > X DIFF
JRST XCHA
SETZ 14, ;↓↓ MOVE UP AND RIGHT
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOOP: ADD 15,C
TLZE 15,200000
ADDI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG INLOOP
JRST DONXT
XCHA: SETZ 14, ;↓↓MOVE UP AND RIGHT
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
INLOO: ADD 15,0
TLZN 15,200000
JRST MVUP
SKIPGE B
SOJ X,
ROT B,1
MVUP: ADDI Y,LBUFL+1
IORM B,@X
SOJG C,INLOO
JRST DONXT
MVDWN: MOVMS C ;↓↓MOVE DOWN AND RIGHT
CAMLE C,0
JRST XCHA2 ;JUMP IF YDIFF > XDIFF
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOP: ADD 15,C
TLZE 15,200000
SUBI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG INLOP
JRST DONXT
XCHA2: SETZ 14, ;↓↓MOVE DOWN AND RIGHT
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
INOOP: ADD 15,0
TLZN 15,200000
JRST MVEX
SKIPGE B
SOJ X,
ROT B,1
MVEX: SUBI Y,LBUFL+1
IORM B,@X
SOJG C,INOOP
JRST DONXT
NRT: JUMPL B,GOOP ;HORZ RIGHT
TOOT: ROT B,1
IORM B,@X
SOJG 0,NRT
JRST DONXT
GOOP: SOJ X,
CAIGE 0,44
JRST TOOT
IDIVI 0,44
SETOM @X
SOJ X,
SOJG 0,.-2
HRR 0,1
JUMPN 0,TOOT
AOJ X,
JRST DONXT
NLFT: MOVMS 0 ;HORZ LEFT
ROT B,-1
JUMPL B,ROOT
WOOP: IORM B,@X
SOJG 0,.-3
JRST DONXT
ROOT: AOJ X,
CAIGE 0,44
JRST WOOP
IDIVI 0,44
SETOM @X
AOJ X,
SOJG 0,.-2
HRR 0,1
JUMPN 0,WOOP
SOJ X,
ROT B,1
JRST DONXT
NORMX: JUMPE C,SAVAC ;ENOUT ;NO DIFF
JUMPL C,MDOWN ;MOVE VERT DOWN
MUP: ADDI Y,LBUFL+1 ;MOVE VERT UP
IORM B,@X
SOJG C,MUP
JRST DONXT
MDOWN: SUBI Y,LBUFL+1 ;MOVE VERT DOWN
IORM B,@X
AOJL C,MDOWN
DONXT: MOVE 4,SVX ;DONE. NOW UPDATE X AND Y
MOVEM 4,XX
NXTY: MOVE 4,SVY
MOVEM 4,YY
;ENOUT: JRST SAVAC ;SAVE ALL ACS
;AOBJN E,PLOT1 ;GET NEXT
SAVAC: MOVEM 16,ACS+16 ;SAVE AC16
MOVEI 16,ACS ;ARG. FOR BLT
BLT 16,ACS+15 ;WE'VE ALREADY SAVED AC16
MOVE 16,ACS+16
POPJ P,
ACS: BLOCK 17 ;SAVE AC'S 0-16
GETAC: HRLZI 16,ACS
BLT 16,16 ;GET 'EM ALL BACK
POPJ P,
SAVACZ: MOVEM 16,ACZ+16 ;SAVE AC16
MOVEI 16,ACZ ;ARG. FOR BLT
BLT 16,ACZ+15 ;WE'VE ALREADY SAVED AC16
MOVE 16,ACZ+16
POPJ P,
ACZ: BLOCK 17 ;SAVE AC'S 0-16
GETACZ: HRLZI 16,ACZ
BLT 16,16 ;GET 'EM ALL BACK
POPJ P,
MVLFT: MOVMS 0 ;MOVE LEFT THEN RIGHT
MOVMS 15
JUMPE C,NLFT
HRR Y,SVYOD
IDIVI 15,44
ADD X,15
XEND: SOJL 16,DUN
ROT B,-1
JUMPGE B,XEND
AOJ X,
JRST XEND
DUN: MOVEM X,XX ;SAVE NEW X POS
MOVEM B,YY
IORM B,@X
JUMPL C,MVLD
CAMLE C,0
JRST XCHA3
SETZ 14, ;MOVE LEFT UP
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
ILOOP: ADD 15,C
TLZE 15,200000
SUBI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG ILOOP
JRST BFOR
XCHA3: SETZ 14,
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
ILOP: ADD 15,0
TLZN 15,200000
JRST DOQ
SKIPGE B
SOJ X,
ROT B,1
DOQ: SUBI Y,LBUFL+1
IORM B,@X
SOJG C,ILOP
JRST BFOR
MVLD: MOVMS C ;MOVE LEFT DOWN
CAMLE C,0
JRST XCHA4
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
LOOP: ADD 15,C
TLZE 15,200000
ADDI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG LOOP
JRST BFOR
XCHA4: SETZ 14,
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
LOP: ADD 15,0
TLZN 15,200000
JRST DOP
SKIPGE B
SOJ X,
ROT B,1
DOP: ADDI Y,LBUFL+1
IORM B,@X
SOJG C,LOP
BFOR: HRR Y,SVYOD ;RESTORE PEN TO NEW PEN
MOVE X,XX
MOVE B,YY
JRST DONXT
OOBAR: SETZM OOBFLG ; GET HERE IF ALL READY OOB
AOSG SSS ; THIS IS FOR THE FIRST OOB FROM MP
JRST FIXUP ;
PENUP: HRR Y,SVYOD ; PEN IS UP GET NEW Y
JUMPE 15,NXTY ;IF VERT
JUMPL 15,PULFT ;IF LEFT
CAIGE 15,44 ;↓↓MOVE UP PEN RIGHT TO NEW X
JRST XLOOP
IDIVI 15,44
SUB X,15
HRR 15,16
XLOOP: SOJL 15,DONXT
SKIPGE B
SOJ X,
ROT B,1
JRST XLOOP
PULFT: MOVMS 15 ;↓↓MOVE UP PEN LEFT TO NEW X
CAIGE 15,44
JRST OOO
IDIVI 15,44
ADD X,15
HRR 15,16
OOO: SOJL 15,DONXT
ROT B,-1
JUMPGE B,OOO
AOJ X,
JRST OOO
LOSEX: MOVE SVPEN ;IF PEN IS UP DON'T PRINT MESSAGE
CAIN 3
JRST PENUP
SETOM OOBFLG ;OOB X
SKIPE POOBX
JRST PENUP
SETOM POOBX
PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ / POINT OUT OF BOUNDS, /
JUMPL 16,[PUSHJ P,ERRPNT
ASCIZ/-X/
JRST PENUP]
PUSHJ P,ERRPNT
ASCIZ/+X/
JRST PENUP
LOSE: SETOM OOBFLG ;OOB Y
SKIPE POOBY
JRST LOBAC
SETOM POOBY
PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ / POINT OUT OF BOUNDS, /
CAIGE 15,(L)
JRST [ PUSHJ P,ERRPNT
ASCIZ/-Y/
JRST LOBAC]
PUSHJ P,ERRPNT
ASCIZ/+Y/
LOBAC: LSHC 14,-16
ASH 15,-26
MOVEM 15,SVX
SUB 15,XX
JRST PENUP
DECOUT: IDIVI T,=10 ;DEC TTY OUT
HRLM TT,(P)
SKIPE T
PUSHJ P,DECOUT
HLRZ TT,(P)
ADDI TT,60
ROT TT,-7
MOVEM TT,.+2
PUSHJ P,ERRPNT
0
POPJ P,
ERRPNT: HRRZ TT,(P) ;ERROR TTY OUT
MOVEM TT,PNTR
MOVEI TT,LINE
TTYMES TT,
JRST [ OUTSTR[ASCIZ/TTYMES FAILED /]
OUTSTR @PNTR
OUTSTR[ASCIZ/
/]
JRST .+1]
POP P,TT
HRL TT,(TT)
TLNE TT,376
AOJA TT,.-2
JRST 1(TT)
XERR: PUSHJ P,ERRPNT ;DET TTY OUT
ASCIZ/
MESSAGE FROM X WORKING ON /
MOVE TT,FILNAM
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/./
HLLZ TT,FILEXT
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/[/
MOVE TT,FILPPN
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/] : /
POPJ P,
SIXOUT: JUMPE TT,CPOPJ ;SIXBIT OUT
SETZ T,
LSHC T,6
ADDI T,40
PUSH P,TT
ROT T,-7
MOVEM T,.+2
PUSHJ P,ERRPNT
0
POP P,TT
JRST SIXOUT
DETCHK: SETOM DET# ;CK FOR DET JOB
GETLIN DET
HRRES DET
SKIPL DET
AOS (P)
POPJ P,
FINDL: HRRZ A,JOBREL ;CK IF BIG ENUF
CAIL A,-LBUFL-1(U)
JRST XINL-1
XL2: MOVEM TT,(T) ;ADD MORE AND MARK
ADDI T,LBUFL+1
CAIGE T,(A)
JRST XL2
SUBI A,(L)
MOVNS A
HRLM A,XGPPTR
SUBI T,LBUFL+1
JRST XXOUT
PCUT: PUSHJ P,GETAC ;GET BACK ACS
HRRZ L,XGPPTR ;MARK BLOCK FOR XGP
MOVE TT,[BYTE (12)4001,LMAR,LBUFL]
MOVEM TT,1(L) ;FIRST ONE HAS MARK AND CUT WITH IT
TLZ TT,400000 ;DELETE MARK AND CUT
MOVEI T,1+LBUFL+1(L)
;; SKIPGE DEFA ;IF(DEFA.EQ.0)WE GET C.5" OF EXTRA PAPER
JRST FINDL
MOVE B,SVBBB
XINL: MOVEM TT,(T)
ADDI T,LBUFL+1
SOJG B,XINL
HLRO TT,XGPPTR
MOVNS TT
ADDI TT,(L)
MOVE A,(TT)
XXOUT: MOVSI TT,400100
MOVEM TT,(T) ;SO DOES LAST
XGPOUT: SKIPE SAVBIT ;SAVE THE BIT MAP?
JRST OUTFIL ;YES
OPEN XGP,XNIT ;XGP OUTPUT
JRST NOXGP
OUTSTR[ASCIZ/
CRANKING XGP
/]
LOCK
OUTIT: OUT XGP,XGPPTR
JRST OUTOK
DSKERR: PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /XGP OUTPUT ERROR.
/
OUTOK: UNLOCK
RELEAS XGP,
XMORE: PUSHJ P,DETCHK
JFCL
OUTSTR[ASCIZ/R=REPEAT, X=EXIT /]
INCHRW C
CAIE C,15
JRST .+3
INCHRW C
JRST XMORE+2 ; WON'T ACCEPT JUST CRLF
OUTSTR[ASCIZ/
/]
CAIE C,"X"
CAIN C,"x"
SKIPA
JRST .+3
PUSHJ P,CORDWN ;REALLY DONE, CORE DOWN
JRST NODEL
CAIE C,"R"
CAIN C,"r"
JRST XGPOUT
JRST XMORE+2 ;******* NO DELETE FEATURE IN THIS VERSION.
CAIE C,"D"
CAIN C,"d"
SKIPA ;IF NOT R, X OR D TRY AGAIN.
JRST XMORE+2
PUSHJ P,CORDWN ;REALLY DONE, CORE DOWN
DODEL: MOVE A,[FILNAM,,LKENT]
BLT A,LKENT+3
INIT DSK,17
'DSK '
0
JRST [ SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/COULDN'T GET DISK FOR DELETE!
/
JRST NODEL]
LOOKUP DSK,LKENT
JRST [ SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/LOOKUP FOR DELETE FAILED!
/
JRST NODEL]
MOVE A,FILPPN
MOVEM A,LKENT+3
SETZM LKENT
RENAME DSK,LKENT
CAIA
JRST NODEL
SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/RENAME FOR DELETE FAILED!
/
NODEL: RELEASE DSK,
SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/ALL DONE!
/
CALLI 12 ;LEAVE
NOXGP: PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /
WAITING FOR XGP -- /
HRRZI A,1017
HRRZM A,XNIT
JRST XGPOUT
XNIT: 417
'XGP '
0
XGPPTR: BLOCK 2
IFN LSTBIT-1,<
XFIX: MOVE A,[LSTBIT-1]
HRRZ C,JOBREL
HRRZ D,XGPPTR
XFIXL: ANDCAM A,LBUFL-1+2(D)
ADDI D,LBUFL+1
CAIGE D,(C)
JRST XFIXL
POPJ P,
>
CORDWN: MOVE T,JOBFF
SUBI T,1
CALLI T,11
JRST 4,.
POPJ P,
INBITS: PUSHJ P,NAMGET ;INPUT OLD BIT FILE
HRRZ U,JOBFF
HRRZI T,177(U)
CORE T,
JRST INBITS
SOJ U,
HRLI U,-200
OPEN [17↔'DSK '↔0]
JRST INBITS
LOOKUP FILNAM
JRST INBITS
SETZ 10,
TRYTRY: OPEN XGP,XNIT ;***** GRAB THE XGP BEFORE CORE EXPANSION
JRST NONO ;CAN'T GET IT!
INPUT U
MOVE T,[BYTE (12)4001,LMAR,LBUFL]
EXCH T,1(U)
HLL U,T
MOVEM U,XGPPTR
HRLI U,(T)
TLNN U,777777
JRST CLOZE
ADDI U,200
MOVNI T,(T)
ADDI T,(U)
CORE T,
JRST INBITS ;HANG
INPUT U
CLOZE: RELEAS
JRST XGPOUT
NONO: OUTSTR[ASCIZ/
WAITING FOR XGP /]
HRRZI A,1017
HRRZM A,XNIT
JRST TRYTRY
OUTFIL: OUTSTR [ASCIZ/
--- WRITING /]
; OUTSTR FNX ;THE OUTPUT NAME - SAME AS FILNAM (SIXBIT)
PUSHJ P,SAVAC
JSA 16,TYPWRD
JUMP FNX ;THE FILE NAME
OUTSTR [ASCIZ/.XGP -- /]
PUSHJ P,GETAC ;I GUESS I NEED ORIGINAL ACS BACK.
MOVSI A,'XGP'
MOVEM A,FILEXT
MOVE U,XGPPTR
HLRO T,U
MOVNS T
OUTF2: TRZ T,177
HRRZI A,200(T)
ADDI A,(U)
CAMG A,JOBREL ;IS THERE ENOUGH CORE?
JRST ENUF ;YES
MOVE B,JOBREL ;NO, SAVE OLD CORE SIZE
CORE A, ;UP THE CORE
JRST OUTFIL ;ERROR
HRRZ 1,B ;OLD CORE SIZE
MOVSI 2,1(1) ;FIRST NEW WORD WE'LL GET
HRRI 2,2(1) ;SECOND NEW WORD - 2 HAS A BLT POINTER.
HRRZ 1,JOBREL ;NEW CORE SIZE NOW
SETZM -1(2)
BLT 2,(1) ;ZERO NEW CORE
ENUF: MOVNS T
HLL T,U ;FIRST WD IS WC-200,-WC
MOVEM T,1(U)
HRLI U,-200(T)
SETZ 10,
UDP: JRST NOUDP ;CHANGE IN DDT TO JFCL TO WRITE ON UDP1
OPEN [17↔'UDP1 '↔0]
JRST 4,.
ENTER FILNAM
CAIA
JRST .+5 ;SKIP NEXT IF WRITING ON UDP1
NOUDP: OPEN [17↔'DSK '↔0]
JRST 4,.
ENTER FILNAM
CAIA
MOVEI 0,HEADER
SUBI 0,1
MOVEM 0,COM
MOVNI 0,200
HRLM 0,COM
OUTPUT COM
STATZ 0,740000
HALT ;ERROR <WRITE ERROR>
OUTPUT U
RELEAS
PUSHJ P,CORDWN ;GET RID OF EXCESS CORE
JRST NODEL
COM: 0
0
HEADER: 0
0
=119 ;MUST BE 1 MORE THAN LBUFL ON PAGE 2.
0
PWIDTH: =1700 ;NUMBER OF SCAN LINES IN FILE. 8.5"
0 ;ABOVE IS SET AT INIT STAGE.
117 ;WORD 2 +DECIMAL 37 -- NOT NEEDED
0
0
0
;CORUP
CORUP:
REPEAT 0,< OLD WAY - FLUSHED BY REG 1-3-76
HRRZ B,JOBCNI
CAIE B,20000
DISMIS
MOVE A,JOBTPC
MOVEM A,IPC+1
UWAIT
DEBREAK
>;END REPEAT 0
BUST: MOVEM 1,SVONE#
MOVEM 2,SVTWO#
MOVEM TT,SVTTT#
MOVE 1,JOBCNI ;REG GET APR CONI BITS
TRNN 1,20000 ;REG IS THERE AN MPV?
JRST NOMPV ;REG NO
HRRZ 1,JOBREL ;OLD CORE SIZE
MOVSI 2,1(1) ;FIRST NEW WORD WE'LL GET
HRRI 2,2(1) ;SECOND NEW WORD - 2 HAS A BLT POINTER.
ADDI 1,16000
;; ADDI 1,10000 ;GET ANOTHER 8K
MOVE TT,1
CORE 1,
PUSHJ P,CORLUZ
HRRZ 1,JOBREL
SETZM -1(2)
BLT 2,(1) ;ZERO NEW CORE
MOVE 1,SVONE
MOVE 2,SVTWO
MOVE TT,SVTTT
REPEAT 0,<
INTJEN IPC
>
JRST 2,@JOBTPC ;REG THIS IS HOW TO DISMISS OLD INTERRUPT
NOMPV: OUTSTR [ASCIZ/UNEXPECTED INTERRUPT?
/]
JRST 2,@JOBTPC
CORLUZ: MOVE T,TT
LSH T,-12
PUSH P,T
PUSHJ P,DETCHK
PUSHJ P,XERR
POP P,T
PUSHJ P,DECOUT
PUSHJ P,ERRPNT
ASCIZ / K OF CORE NEEDED!
/
SKIPGE DET
CALLI 12
JRST ASKLEN
FNF: PUSHJ P,DETCHK ;FILE NOT FOUND
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /LOOKUP FAILED.
/
SKIPGE DET
CALLI 12
JRST FILIN
;******** TYPE '4' FOR 4X4 DOTS, TYPE '9' FOR 9X9 DOTS.***********
FRD: MOVSI A,'PLT' ;FILE SCAN
MOVEM A,FILEXT
PUSHJ P,GETNAM
NOSAV: SKIPN A
MOVE A,['PLT ']
MOVEM A,FILNAM
CAIE C,"."
JRST NOEXT
PUSHJ P,GETNAM
MOVEM A,FILEXT
NOEXT: CAIE C,"["
JRST FRDX
PUSHJ P,GETP
HRLZM A,FILPPN
PUSHJ P,GETP
HRRM A,FILPPN
FRDX: INCHRW C
CAIE C,12
JRST FRDX
POPJ P,
RNUM: INCHWL C ;NUM SCAN
CAIN C,15
JRST RNUM
CAIN C,12
POPJ P,
AOS (P)
MOVEI A,
SETZM SIGN
CAIN C,"-"
JRST [ PUSHJ P,RNUML
SETOM SIGN
MOVN A,A
POPJ P,]
CAIN C,"+"
RNUML: INCHWL C
CAIL C,"0"
CAILE C,"9"
JRST RNUMX
IMULI A,12
ADDI A,-"0"(C)
JRST RNUML
RNUMX: CAIN C,15
INCHRW C
POPJ P,
INCHLF: INCHWL 0 ;GET ANOTHER CHARACTER
CAIE 0,12 ;WAS IT A LF?
JRST INCHLF ;GET THE LF
POPJ P,
GETNAM: MOVEI A, ;FILE SCAN
MOVE B,[440600,,A]
GETNML: PUSHJ P,RCH
POPJ P,
SUBI C,40
TLNE B,770000
IDPB C,B
JRST GETNML
GETP: MOVEI A,
GETPL: PUSHJ P,RCH
POPJ P,
TRNE A,770000
JRST GETPL
LSH A,6
ADDI A,-40(C)
JRST GETPL
RCH: INCHWL C
CAIN C,42
JRST RCHQ
CAIE C,11
CAIN C," "
JRST RCH
CAIE C,"."
CAIN C,","
POPJ P,
CAIE C,"["
CAIN C,"]"
POPJ P,
RCHQR: CAIGE C,40
POPJ P,
CAIL C,"a"
CAILE C,"z"
CAIA
SUBI C,40
JRST POPJ1
RCHQ: INCHWL C
JRST RCHQR
NAMGET: PUSHJ P,INCHLF
OUTSTR [ASCIZ/
FILE = /]
SETZM FILEXT+1
SETZM FILPPN
MOVSI A,'BIT'
MOVEM A,FILEXT
PUSHJ P,GETNAM
SKIPN A
MOVE A,['PLT ']
MOVEM A,FILNAM
CAIE C,"."
JRST NOEXTN
PUSHJ P,GETNAM
MOVEM A,FILEXT
NOEXTN: CAIE C,"["
JRST FFDX
PUSHJ P,GETP
HRLZM A,FILPPN
PUSHJ P,GETP
HRRM A,FILPPN
FFDX: INCHRW C
CAIE C,12
JRST FFDX
POPJ P,
FILNAM: 0 ;GLOPS OF JUNK
FILEXT: 0
0
FILPPN: 0
LKENT: BLOCK 4
XGSNAM: 0
XGSEXT: 0
0
XGSPPN: 0
IBUF: BLOCK 3
BITTAB: FOR I←43,0,-1{1⊗I
}
BYTTAB: FOR I←36,0,-6{REPEAT 6,{77⊗I}}
DBUF: BLOCK LBUFL+2
END